| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
2
|
|
|
|
|
|
|
## MIME Email Builder - ~/lib/Mail/Make/SMIME.pm |
|
3
|
|
|
|
|
|
|
## Version v0.1.2 |
|
4
|
|
|
|
|
|
|
## Copyright(c) 2026 DEGUEST Pte. Ltd. |
|
5
|
|
|
|
|
|
|
## Author: Jacques Deguest <jack@deguest.jp> |
|
6
|
|
|
|
|
|
|
## Created: 2026/03/07 |
|
7
|
|
|
|
|
|
|
## Modified: 2026/03/07 |
|
8
|
|
|
|
|
|
|
## All rights reserved. |
|
9
|
|
|
|
|
|
|
## |
|
10
|
|
|
|
|
|
|
## This program is free software; you can redistribute it and/or modify it |
|
11
|
|
|
|
|
|
|
## under the same terms as Perl itself. |
|
12
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
13
|
|
|
|
|
|
|
package Mail::Make::SMIME; |
|
14
|
|
|
|
|
|
|
BEGIN |
|
15
|
|
|
|
|
|
|
{ |
|
16
|
2
|
|
|
2
|
|
6286
|
use strict; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
77
|
|
|
17
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
165
|
|
|
18
|
2
|
|
|
2
|
|
18
|
warnings::register_categories( 'Mail::Make' ); |
|
19
|
2
|
|
|
2
|
|
11
|
use parent qw( Module::Generic ); |
|
|
2
|
|
|
|
|
161
|
|
|
|
2
|
|
|
|
|
19
|
|
|
20
|
2
|
|
|
2
|
|
171
|
use vars qw( $VERSION $EXCEPTION_CLASS ); |
|
|
2
|
|
|
|
|
5
|
|
|
|
2
|
|
|
|
|
141
|
|
|
21
|
2
|
|
|
|
|
20
|
our $EXCEPTION_CLASS = 'Mail::Make::Exception'; |
|
22
|
2
|
|
|
|
|
64
|
our $VERSION = 'v0.1.2'; |
|
23
|
|
|
|
|
|
|
}; |
|
24
|
|
|
|
|
|
|
|
|
25
|
2
|
|
|
2
|
|
10
|
use strict; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
114
|
|
|
26
|
2
|
|
|
2
|
|
7
|
use warnings; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
5684
|
|
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# init( %opts ) |
|
29
|
|
|
|
|
|
|
# Initialises attributes. Accepted constructor options (all optional): |
|
30
|
|
|
|
|
|
|
# ca_cert => $pem_string_or_file CA certificate(s) for chain verification |
|
31
|
|
|
|
|
|
|
# cert => $pem_string_or_file Signer certificate (PEM) |
|
32
|
|
|
|
|
|
|
# key => $pem_string_or_file Private key (PEM) |
|
33
|
|
|
|
|
|
|
# key_password => $string_or_coderef Passphrase for encrypted private key |
|
34
|
|
|
|
|
|
|
sub init |
|
35
|
|
|
|
|
|
|
{ |
|
36
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
37
|
0
|
|
|
|
|
|
$self->{ca_cert} = undef; # PEM string or file path: CA cert(s) for verification |
|
38
|
0
|
|
|
|
|
|
$self->{cert} = undef; # PEM string or file path: signer certificate |
|
39
|
0
|
|
|
|
|
|
$self->{key} = undef; # PEM string or file path: private key |
|
40
|
0
|
|
|
|
|
|
$self->{key_password} = undef; # string or CODE ref; undef = unencrypted key |
|
41
|
0
|
|
|
|
|
|
$self->{_exception_class} = $EXCEPTION_CLASS; |
|
42
|
0
|
0
|
|
|
|
|
$self->SUPER::init( @_ ) || return( $self->pass_error ); |
|
43
|
0
|
|
|
|
|
|
return( $self ); |
|
44
|
|
|
|
|
|
|
} |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# ca_cert( [$pem_or_file] ) |
|
47
|
0
|
|
|
0
|
1
|
|
sub ca_cert { return( shift->_set_get_scalar( 'ca_cert', @_ ) ); } |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# cert( [$pem_or_file] ) |
|
50
|
0
|
|
|
0
|
1
|
|
sub cert { return( shift->_set_get_scalar( 'cert', @_ ) ); } |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# encrypt( entity => $mail_make, RecipientCert => $cert_or_arrayref [, %opts] ) |
|
53
|
|
|
|
|
|
|
# Encrypts $mail_make for one or more recipients. Returns a new Mail::Make object whose |
|
54
|
|
|
|
|
|
|
# entity is a RFC 5751 application/pkcs7-mime enveloped message. |
|
55
|
|
|
|
|
|
|
# |
|
56
|
|
|
|
|
|
|
# Required options: |
|
57
|
|
|
|
|
|
|
# entity => Mail::Make object |
|
58
|
|
|
|
|
|
|
# RecipientCert => PEM string, file path, or arrayref of either |
|
59
|
|
|
|
|
|
|
# |
|
60
|
|
|
|
|
|
|
# Optional options: |
|
61
|
|
|
|
|
|
|
# Cipher => 'DES3' | 'AES128' | 'AES256' (default: AES256) |
|
62
|
|
|
|
|
|
|
sub encrypt |
|
63
|
|
|
|
|
|
|
{ |
|
64
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
65
|
0
|
|
|
|
|
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
66
|
|
|
|
|
|
|
my $entity = $opts->{entity} || |
|
67
|
0
|
|
0
|
|
|
|
return( $self->error( 'encrypt(): entity option is required.' ) ); |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
my $recipient_cert = $opts->{RecipientCert} || |
|
70
|
0
|
|
0
|
|
|
|
return( $self->error( 'encrypt(): RecipientCert option is required.' ) ); |
|
71
|
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# Ensure Date and Message-ID exist before serialising |
|
73
|
0
|
0
|
|
|
|
|
$self->_ensure_envelope_headers( $entity ) || return( $self->pass_error ); |
|
74
|
|
|
|
|
|
|
|
|
75
|
0
|
|
0
|
|
|
|
my $smime = $self->_make_crypt_smime || return( $self->pass_error ); |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# Load recipient certificate(s) as public key(s) |
|
78
|
0
|
0
|
|
|
|
|
my @certs = ref( $recipient_cert ) eq 'ARRAY' |
|
79
|
|
|
|
|
|
|
? @$recipient_cert |
|
80
|
|
|
|
|
|
|
: ( $recipient_cert ); |
|
81
|
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
my @pem_certs; |
|
83
|
0
|
|
|
|
|
|
for my $cert ( @certs ) |
|
84
|
|
|
|
|
|
|
{ |
|
85
|
0
|
|
0
|
|
|
|
my $pem = $self->_read_pem( $cert ) || return( $self->pass_error ); |
|
86
|
0
|
|
|
|
|
|
push( @pem_certs, $pem ); |
|
87
|
|
|
|
|
|
|
} |
|
88
|
|
|
|
|
|
|
|
|
89
|
0
|
|
|
|
|
|
local $@; |
|
90
|
0
|
|
|
|
|
|
eval{ $smime->setPublicKey( \@pem_certs ) }; |
|
|
0
|
|
|
|
|
|
|
|
91
|
0
|
0
|
|
|
|
|
return( $self->error( "encrypt(): failed to load recipient certificate(s): $@" ) ) if( $@ ); |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Serialise the full message |
|
94
|
0
|
|
0
|
|
|
|
my $raw = $self->_serialise_for_smime( $entity ) || return( $self->pass_error ); |
|
95
|
|
|
|
|
|
|
|
|
96
|
0
|
|
|
|
|
|
my $encrypted; |
|
97
|
0
|
|
|
|
|
|
eval{ $encrypted = $smime->encrypt( $raw ) }; |
|
|
0
|
|
|
|
|
|
|
|
98
|
0
|
0
|
|
|
|
|
return( $self->error( "encrypt(): Crypt::SMIME::encrypt() failed: $@" ) ) if( $@ ); |
|
99
|
0
|
0
|
0
|
|
|
|
unless( defined( $encrypted ) && CORE::length( $encrypted ) ) |
|
100
|
|
|
|
|
|
|
{ |
|
101
|
0
|
|
|
|
|
|
return( $self->error( 'encrypt(): Crypt::SMIME returned empty result.' ) ); |
|
102
|
|
|
|
|
|
|
} |
|
103
|
|
|
|
|
|
|
|
|
104
|
0
|
|
|
|
|
|
return( $self->_build_from_smime_output( $entity, $encrypted ) ); |
|
105
|
|
|
|
|
|
|
} |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# key( [$pem_or_file] ) |
|
108
|
0
|
|
|
0
|
1
|
|
sub key { return( shift->_set_get_scalar( 'key', @_ ) ); } |
|
109
|
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# key_password( [$string_or_coderef] ) |
|
111
|
0
|
|
|
0
|
1
|
|
sub key_password { return( shift->_set_get_scalar( 'key_password', @_ ) ); } |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# sign( entity => $mail_make [, %opts] ) |
|
114
|
|
|
|
|
|
|
# Signs $mail_make with a detached S/MIME signature. Returns a new Mail::Make |
|
115
|
|
|
|
|
|
|
# object whose entity is a RFC 5751 multipart/signed message. |
|
116
|
|
|
|
|
|
|
# |
|
117
|
|
|
|
|
|
|
# Required option (or set via constructor / accessors): |
|
118
|
|
|
|
|
|
|
# entity => Mail::Make object |
|
119
|
|
|
|
|
|
|
# Cert => PEM string or file path (overrides $self->{cert}) |
|
120
|
|
|
|
|
|
|
# Key => PEM string or file path (overrides $self->{key}) |
|
121
|
|
|
|
|
|
|
# |
|
122
|
|
|
|
|
|
|
# Optional options: |
|
123
|
|
|
|
|
|
|
# KeyPassword => string or CODE ref (overrides $self->{key_password}) |
|
124
|
|
|
|
|
|
|
# CACert => PEM string or file path |
|
125
|
|
|
|
|
|
|
sub sign |
|
126
|
|
|
|
|
|
|
{ |
|
127
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
128
|
0
|
|
|
|
|
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
129
|
|
|
|
|
|
|
my $entity = $opts->{entity} || |
|
130
|
0
|
|
0
|
|
|
|
return( $self->error( 'sign(): entity option is required.' ) ); |
|
131
|
|
|
|
|
|
|
|
|
132
|
0
|
0
|
|
|
|
|
$self->_ensure_envelope_headers( $entity ) || return( $self->pass_error ); |
|
133
|
|
|
|
|
|
|
|
|
134
|
0
|
|
0
|
|
|
|
my $smime = $self->_make_crypt_smime || return( $self->pass_error ); |
|
135
|
|
|
|
|
|
|
|
|
136
|
0
|
0
|
|
|
|
|
$self->_load_private_key( $smime, $opts ) || return( $self->pass_error ); |
|
137
|
|
|
|
|
|
|
|
|
138
|
0
|
|
|
|
|
|
$self->_load_ca_cert( $smime, $opts ); # optional; ignore error |
|
139
|
|
|
|
|
|
|
|
|
140
|
0
|
|
0
|
|
|
|
my $raw = $self->_serialise_for_smime( $entity ) || return( $self->pass_error ); |
|
141
|
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
my $signed; |
|
143
|
0
|
|
|
|
|
|
local $@; |
|
144
|
0
|
|
|
|
|
|
eval{ $signed = $smime->sign( $raw ) }; |
|
|
0
|
|
|
|
|
|
|
|
145
|
0
|
0
|
|
|
|
|
return( $self->error( "sign(): Crypt::SMIME::sign() failed: $@" ) ) if( $@ ); |
|
146
|
0
|
0
|
0
|
|
|
|
unless( defined( $signed ) && CORE::length( $signed ) ) |
|
147
|
|
|
|
|
|
|
{ |
|
148
|
0
|
|
|
|
|
|
return( $self->error( 'sign(): Crypt::SMIME returned empty result.' ) ); |
|
149
|
|
|
|
|
|
|
} |
|
150
|
|
|
|
|
|
|
|
|
151
|
0
|
|
|
|
|
|
return( $self->_build_from_smime_output( $entity, $signed ) ); |
|
152
|
|
|
|
|
|
|
} |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# sign_encrypt( entity => $mail_make, RecipientCert => $cert [, %opts] ) |
|
155
|
|
|
|
|
|
|
# Signs then encrypts $mail_make. Returns a new Mail::Make object. |
|
156
|
|
|
|
|
|
|
# |
|
157
|
|
|
|
|
|
|
# Required options: |
|
158
|
|
|
|
|
|
|
# entity => Mail::Make object |
|
159
|
|
|
|
|
|
|
# Cert => PEM string or file path |
|
160
|
|
|
|
|
|
|
# Key => PEM string or file path |
|
161
|
|
|
|
|
|
|
# RecipientCert => PEM string, file path, or arrayref |
|
162
|
|
|
|
|
|
|
# |
|
163
|
|
|
|
|
|
|
# Optional options: |
|
164
|
|
|
|
|
|
|
# KeyPassword => string or CODE ref |
|
165
|
|
|
|
|
|
|
# CACert => PEM string or file path |
|
166
|
|
|
|
|
|
|
# Cipher => 'DES3' | 'AES128' | 'AES256' |
|
167
|
|
|
|
|
|
|
sub sign_encrypt |
|
168
|
|
|
|
|
|
|
{ |
|
169
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
170
|
0
|
|
|
|
|
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
171
|
|
|
|
|
|
|
my $entity = $opts->{entity} || |
|
172
|
0
|
|
0
|
|
|
|
return( $self->error( 'sign_encrypt(): entity option is required.' ) ); |
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
$opts->{RecipientCert} || |
|
175
|
0
|
0
|
|
|
|
|
return( $self->error( 'sign_encrypt(): RecipientCert option is required.' ) ); |
|
176
|
|
|
|
|
|
|
|
|
177
|
0
|
0
|
|
|
|
|
$self->_ensure_envelope_headers( $entity ) || return( $self->pass_error ); |
|
178
|
|
|
|
|
|
|
|
|
179
|
0
|
|
0
|
|
|
|
my $smime = $self->_make_crypt_smime || return( $self->pass_error ); |
|
180
|
|
|
|
|
|
|
|
|
181
|
0
|
0
|
|
|
|
|
$self->_load_private_key( $smime, $opts ) || return( $self->pass_error ); |
|
182
|
|
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
$self->_load_ca_cert( $smime, $opts ); # optional |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# Load recipient certificate(s) |
|
186
|
|
|
|
|
|
|
my @certs = ref( $opts->{RecipientCert} ) eq 'ARRAY' |
|
187
|
0
|
|
|
|
|
|
? @{$opts->{RecipientCert}} |
|
188
|
0
|
0
|
|
|
|
|
: ( $opts->{RecipientCert} ); |
|
189
|
|
|
|
|
|
|
|
|
190
|
0
|
|
|
|
|
|
my @pem_certs; |
|
191
|
0
|
|
|
|
|
|
for my $cert ( @certs ) |
|
192
|
|
|
|
|
|
|
{ |
|
193
|
0
|
|
0
|
|
|
|
my $pem = $self->_read_pem( $cert ) || return( $self->pass_error ); |
|
194
|
0
|
|
|
|
|
|
push( @pem_certs, $pem ); |
|
195
|
|
|
|
|
|
|
} |
|
196
|
|
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
local $@; |
|
198
|
0
|
|
|
|
|
|
eval{ $smime->setPublicKey( \@pem_certs ) }; |
|
|
0
|
|
|
|
|
|
|
|
199
|
0
|
0
|
|
|
|
|
return( $self->error( "sign_encrypt(): failed to load recipient certificate(s): $@" ) ) if( $@ ); |
|
200
|
|
|
|
|
|
|
|
|
201
|
0
|
|
0
|
|
|
|
my $raw = $self->_serialise_for_smime( $entity ) || return( $self->pass_error ); |
|
202
|
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# Crypt::SMIME has no signAndEncrypt() method. RFC 5751 sign-then-encrypt is |
|
204
|
|
|
|
|
|
|
# implemented by signing first, then encrypting the signed output. |
|
205
|
|
|
|
|
|
|
# The signed intermediate is a full RFC 2822 message string; we pass it directly to |
|
206
|
|
|
|
|
|
|
# encrypt() which operates on the same format. |
|
207
|
0
|
|
|
|
|
|
my $signed; |
|
208
|
0
|
|
|
|
|
|
eval{ $signed = $smime->sign( $raw ) }; |
|
|
0
|
|
|
|
|
|
|
|
209
|
0
|
0
|
|
|
|
|
return( $self->error( "sign_encrypt(): Crypt::SMIME::sign() failed: $@" ) ) if( $@ ); |
|
210
|
0
|
0
|
0
|
|
|
|
unless( defined( $signed ) && CORE::length( $signed ) ) |
|
211
|
|
|
|
|
|
|
{ |
|
212
|
0
|
|
|
|
|
|
return( $self->error( 'sign_encrypt(): Crypt::SMIME::sign() returned empty result.' ) ); |
|
213
|
|
|
|
|
|
|
} |
|
214
|
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# Re-load recipient public key(s) on a fresh instance for the encrypt step. |
|
216
|
|
|
|
|
|
|
# The same $smime object already has the private key loaded; calling setPublicKey() |
|
217
|
|
|
|
|
|
|
# again on it works, but to be explicit and avoid any state confusion we reuse $smime |
|
218
|
|
|
|
|
|
|
# (Crypt::SMIME accumulates public keys). |
|
219
|
0
|
|
|
|
|
|
my $result; |
|
220
|
0
|
|
|
|
|
|
eval{ $result = $smime->encrypt( $signed ) }; |
|
|
0
|
|
|
|
|
|
|
|
221
|
0
|
0
|
|
|
|
|
return( $self->error( "sign_encrypt(): Crypt::SMIME::encrypt() failed: $@" ) ) if( $@ ); |
|
222
|
0
|
0
|
0
|
|
|
|
unless( defined( $result ) && CORE::length( $result ) ) |
|
223
|
|
|
|
|
|
|
{ |
|
224
|
0
|
|
|
|
|
|
return( $self->error( 'sign_encrypt(): Crypt::SMIME::encrypt() returned empty result.' ) ); |
|
225
|
|
|
|
|
|
|
} |
|
226
|
|
|
|
|
|
|
|
|
227
|
0
|
|
|
|
|
|
return( $self->_build_from_smime_output( $entity, $result ) ); |
|
228
|
|
|
|
|
|
|
} |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# _build_from_smime_output( $original_mail, $smime_string ) → Mail::Make |
|
231
|
|
|
|
|
|
|
# Parses the S/MIME output string from Crypt::SMIME (which already contains all the correct |
|
232
|
|
|
|
|
|
|
# headers) into a new Mail::Make object that smtpsend() can use directly. |
|
233
|
|
|
|
|
|
|
# |
|
234
|
|
|
|
|
|
|
# Crypt::SMIME::sign() and encrypt() return a fully formed RFC 2822 message string. We |
|
235
|
|
|
|
|
|
|
# wrap it in a Mail::Make object by parsing it into an Entity and storing it as |
|
236
|
|
|
|
|
|
|
# _smime_entity, mirroring what _gpg_entity does for GPG. |
|
237
|
|
|
|
|
|
|
sub _build_from_smime_output |
|
238
|
|
|
|
|
|
|
{ |
|
239
|
0
|
|
|
0
|
|
|
my( $self, $original, $smime_str ) = @_; |
|
240
|
0
|
|
|
|
|
|
require Mail::Make; |
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# Canonicalise line endings to CRLF |
|
243
|
0
|
|
|
|
|
|
( my $canon = $smime_str ) =~ s/\015?\012/\015\012/g; |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# Locate the header / body separator |
|
246
|
0
|
|
|
|
|
|
my $pos = index( $canon, "\015\012\015\012" ); |
|
247
|
0
|
0
|
|
|
|
|
if( $pos < 0 ) |
|
248
|
|
|
|
|
|
|
{ |
|
249
|
0
|
|
|
|
|
|
return( $self->error( '_build_from_smime_output(): no header/body separator in Crypt::SMIME output.' ) ); |
|
250
|
|
|
|
|
|
|
} |
|
251
|
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# Parse outer headers into a plain hash (case-insensitive, last-value wins for duplicates) |
|
253
|
|
|
|
|
|
|
# so that the structure test can call headers->get(). |
|
254
|
0
|
|
|
|
|
|
my $hdr_block = substr( $canon, 0, $pos + 2 ); |
|
255
|
0
|
|
|
|
|
|
my %hdrs; |
|
256
|
0
|
|
|
|
|
|
my $cur_name = ''; |
|
257
|
0
|
|
|
|
|
|
my $cur_value = ''; |
|
258
|
0
|
|
|
|
|
|
for my $line ( split( /(?<=\015\012)/, $hdr_block ) ) |
|
259
|
|
|
|
|
|
|
{ |
|
260
|
0
|
0
|
|
|
|
|
if( $line =~ /^[ \t]/ ) |
|
|
|
0
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
{ |
|
262
|
0
|
|
|
|
|
|
( my $cont = $line ) =~ s/^\015\012$//; # strip trailing CRLF |
|
263
|
0
|
0
|
|
|
|
|
$cur_value .= $line if( CORE::length( $cur_name ) ); |
|
264
|
|
|
|
|
|
|
} |
|
265
|
|
|
|
|
|
|
elsif( $line =~ /^([\x21-\x39\x3B-\x7E]+):\s*(.*?)\015\012$/ ) |
|
266
|
|
|
|
|
|
|
{ |
|
267
|
0
|
0
|
|
|
|
|
$hdrs{ $cur_name } = $cur_value if( CORE::length( $cur_name ) ); |
|
268
|
0
|
|
|
|
|
|
( $cur_name, $cur_value ) = ( $1, $2 ); |
|
269
|
|
|
|
|
|
|
} |
|
270
|
|
|
|
|
|
|
} |
|
271
|
0
|
0
|
|
|
|
|
$hdrs{ $cur_name } = $cur_value if( CORE::length( $cur_name ) ); |
|
272
|
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# _RawEntity wraps the complete Crypt::SMIME output string and exposes just enough of |
|
274
|
|
|
|
|
|
|
# the Entity interface for smtpsend() and the test suite: |
|
275
|
|
|
|
|
|
|
# headers->get( $name ) - used by structure tests |
|
276
|
|
|
|
|
|
|
# headers->remove( $name ) - called by smtpsend() to strip Bcc |
|
277
|
|
|
|
|
|
|
# as_string() - called by smtpsend() for SMTP DATA |
|
278
|
|
|
|
|
|
|
# |
|
279
|
|
|
|
|
|
|
# We deliberately do NOT subclass Mail::Make::Entity here. Entity::print_body |
|
280
|
|
|
|
|
|
|
# branches on is_multipart() and iterates _parts (which would be empty), producing a |
|
281
|
|
|
|
|
|
|
# message with an empty body. Bypassing Entity entirely is the correct fix. |
|
282
|
0
|
|
|
|
|
|
my $entity = Mail::Make::SMIME::_RawEntity->new( \%hdrs, $canon ); |
|
283
|
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# Build the wrapper Mail::Make object |
|
285
|
0
|
|
0
|
|
|
|
my $new = Mail::Make->new || |
|
286
|
|
|
|
|
|
|
return( $self->pass_error( Mail::Make->error ) ); |
|
287
|
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# Copy envelope headers (From, To, Subject, Date, Message-ID …) from the original |
|
289
|
|
|
|
|
|
|
# Mail::Make object so that smtpsend() can derive the SMTP envelope |
|
290
|
|
|
|
|
|
|
# (MAIL FROM / RCPT TO) without inspecting the entity. |
|
291
|
|
|
|
|
|
|
$original->headers->scan( sub |
|
292
|
|
|
|
|
|
|
{ |
|
293
|
0
|
|
|
0
|
|
|
my( $name, $value ) = @_; |
|
294
|
0
|
|
|
|
|
|
$new->headers->set( $name => $value ); |
|
295
|
0
|
|
|
|
|
|
return(1); |
|
296
|
0
|
|
|
|
|
|
}); |
|
297
|
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# Store pre-assembled entity; as_entity() in Mail::Make returns it directly via the |
|
299
|
|
|
|
|
|
|
# _smime_entity hook. |
|
300
|
0
|
|
|
|
|
|
$new->{_smime_entity} = $entity; |
|
301
|
|
|
|
|
|
|
|
|
302
|
0
|
|
|
|
|
|
return( $new ); |
|
303
|
|
|
|
|
|
|
} |
|
304
|
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# _ensure_envelope_headers( $mail_make_obj ) |
|
306
|
|
|
|
|
|
|
# Generates Date and Message-ID on the Mail::Make object without calling as_entity(), to |
|
307
|
|
|
|
|
|
|
# avoid polluting $self->{_parts}[0] with RFC 2822 headers. |
|
308
|
|
|
|
|
|
|
sub _ensure_envelope_headers |
|
309
|
|
|
|
|
|
|
{ |
|
310
|
0
|
|
|
0
|
|
|
my( $self, $mail ) = @_; |
|
311
|
|
|
|
|
|
|
|
|
312
|
0
|
0
|
|
|
|
|
unless( $mail->{_headers}->exists( 'Date' ) ) |
|
313
|
|
|
|
|
|
|
{ |
|
314
|
|
|
|
|
|
|
$mail->{_headers}->init_header( Date => $mail->_format_date ) || |
|
315
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $mail->{_headers}->error ) ); |
|
316
|
|
|
|
|
|
|
} |
|
317
|
|
|
|
|
|
|
|
|
318
|
0
|
0
|
|
|
|
|
unless( $mail->{_headers}->exists( 'Message-ID' ) ) |
|
319
|
|
|
|
|
|
|
{ |
|
320
|
|
|
|
|
|
|
$mail->{_headers}->message_id( |
|
321
|
|
|
|
|
|
|
{ generate => 1, domain => $mail->_default_domain } |
|
322
|
0
|
0
|
|
|
|
|
) || return( $self->pass_error( $mail->{_headers}->error ) ); |
|
323
|
|
|
|
|
|
|
} |
|
324
|
|
|
|
|
|
|
|
|
325
|
0
|
|
|
|
|
|
return(1); |
|
326
|
|
|
|
|
|
|
} |
|
327
|
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# _load_ca_cert( $smime_obj, \%opts ) |
|
329
|
|
|
|
|
|
|
# Loads the CA certificate into a Crypt::SMIME instance for chain verification. |
|
330
|
|
|
|
|
|
|
# Source priority: option CACert > constructor ca_cert. |
|
331
|
|
|
|
|
|
|
# Silently returns 1 if no CA cert is provided (CA cert is optional for signing). |
|
332
|
|
|
|
|
|
|
sub _load_ca_cert |
|
333
|
|
|
|
|
|
|
{ |
|
334
|
0
|
|
|
0
|
|
|
my( $self, $smime, $opts_ref ) = @_; |
|
335
|
|
|
|
|
|
|
|
|
336
|
0
|
|
0
|
|
|
|
my $source = $opts_ref->{CACert} // $self->{ca_cert}; |
|
337
|
0
|
0
|
0
|
|
|
|
return(1) unless( defined( $source ) && CORE::length( $source ) ); |
|
338
|
|
|
|
|
|
|
|
|
339
|
0
|
|
0
|
|
|
|
my $pem = $self->_read_pem( $source ) || return( $self->pass_error ); |
|
340
|
|
|
|
|
|
|
|
|
341
|
0
|
|
|
|
|
|
local $@; |
|
342
|
0
|
|
|
|
|
|
eval{ $smime->setPublicKey( [$pem] ) }; |
|
|
0
|
|
|
|
|
|
|
|
343
|
0
|
0
|
|
|
|
|
return( $self->error( "_load_ca_cert(): failed to load CA certificate: $@" ) ) if( $@ ); |
|
344
|
|
|
|
|
|
|
|
|
345
|
0
|
|
|
|
|
|
return(1); |
|
346
|
|
|
|
|
|
|
} |
|
347
|
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
# _load_private_key( $smime_obj, \%opts ) |
|
349
|
|
|
|
|
|
|
# Loads the private key and signing certificate into a Crypt::SMIME instance. |
|
350
|
|
|
|
|
|
|
# Source priority: option Cert/Key > constructor cert/key. |
|
351
|
|
|
|
|
|
|
# Handles key_password as string or CODE ref. |
|
352
|
|
|
|
|
|
|
sub _load_private_key |
|
353
|
|
|
|
|
|
|
{ |
|
354
|
0
|
|
|
0
|
|
|
my( $self, $smime, $opts_ref ) = @_; |
|
355
|
|
|
|
|
|
|
|
|
356
|
0
|
|
0
|
|
|
|
my $cert_source = $opts_ref->{Cert} // $self->{cert}; |
|
357
|
0
|
|
0
|
|
|
|
my $key_source = $opts_ref->{Key} // $self->{key}; |
|
358
|
|
|
|
|
|
|
|
|
359
|
0
|
0
|
0
|
|
|
|
unless( defined( $cert_source ) && CORE::length( $cert_source ) ) |
|
360
|
|
|
|
|
|
|
{ |
|
361
|
0
|
|
|
|
|
|
return( $self->error( '_load_private_key(): no certificate provided. Set Cert option or cert() accessor.' ) ); |
|
362
|
|
|
|
|
|
|
} |
|
363
|
|
|
|
|
|
|
|
|
364
|
0
|
0
|
0
|
|
|
|
unless( defined( $key_source ) && CORE::length( $key_source ) ) |
|
365
|
|
|
|
|
|
|
{ |
|
366
|
0
|
|
|
|
|
|
return( $self->error( '_load_private_key(): no private key provided. Set Key option or key() accessor.' ) ); |
|
367
|
|
|
|
|
|
|
} |
|
368
|
|
|
|
|
|
|
|
|
369
|
0
|
|
0
|
|
|
|
my $cert_pem = $self->_read_pem( $cert_source ) || return( $self->pass_error ); |
|
370
|
|
|
|
|
|
|
|
|
371
|
0
|
|
0
|
|
|
|
my $key_pem = $self->_read_pem( $key_source ) || return( $self->pass_error ); |
|
372
|
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
# Resolve key password |
|
374
|
0
|
|
0
|
|
|
|
my $password_src = $opts_ref->{KeyPassword} // $self->{key_password}; |
|
375
|
0
|
|
|
|
|
|
my $password; |
|
376
|
0
|
0
|
|
|
|
|
if( defined( $password_src ) ) |
|
377
|
|
|
|
|
|
|
{ |
|
378
|
0
|
0
|
|
|
|
|
if( ref( $password_src ) eq 'CODE' ) |
|
379
|
|
|
|
|
|
|
{ |
|
380
|
0
|
|
|
|
|
|
local $@; |
|
381
|
0
|
|
|
|
|
|
$password = eval{ $password_src->() }; |
|
|
0
|
|
|
|
|
|
|
|
382
|
0
|
0
|
|
|
|
|
return( $self->error( "_load_private_key(): KeyPassword CODE ref died: $@" ) ) if( $@ ); |
|
383
|
|
|
|
|
|
|
} |
|
384
|
|
|
|
|
|
|
else |
|
385
|
|
|
|
|
|
|
{ |
|
386
|
0
|
|
|
|
|
|
$password = $password_src; |
|
387
|
|
|
|
|
|
|
} |
|
388
|
|
|
|
|
|
|
} |
|
389
|
|
|
|
|
|
|
|
|
390
|
0
|
|
|
|
|
|
local $@; |
|
391
|
0
|
0
|
|
|
|
|
if( defined( $password ) ) |
|
392
|
|
|
|
|
|
|
{ |
|
393
|
0
|
|
|
|
|
|
eval{ $smime->setPrivateKey( $key_pem, $cert_pem, $password ) }; |
|
|
0
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
} |
|
395
|
|
|
|
|
|
|
else |
|
396
|
|
|
|
|
|
|
{ |
|
397
|
0
|
|
|
|
|
|
eval{ $smime->setPrivateKey( $key_pem, $cert_pem ) }; |
|
|
0
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
} |
|
399
|
0
|
0
|
|
|
|
|
return( $self->error( "_load_private_key(): failed to load private key/certificate: $@" ) ) if( $@ ); |
|
400
|
|
|
|
|
|
|
|
|
401
|
0
|
|
|
|
|
|
return(1); |
|
402
|
|
|
|
|
|
|
} |
|
403
|
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
# _make_crypt_smime() → Crypt::SMIME instance |
|
405
|
|
|
|
|
|
|
# Loads Crypt::SMIME and returns a new instance, with a clear error if the module is not |
|
406
|
|
|
|
|
|
|
# installed. |
|
407
|
|
|
|
|
|
|
sub _make_crypt_smime |
|
408
|
|
|
|
|
|
|
{ |
|
409
|
0
|
|
|
0
|
|
|
my $self = shift( @_ ); |
|
410
|
0
|
0
|
|
|
|
|
$self->_load_class( 'Crypt::SMIME' ) || |
|
411
|
|
|
|
|
|
|
return( $self->error( 'Crypt::SMIME is required for S/MIME operations. Install it with: cpan Crypt::SMIME' ) ); |
|
412
|
|
|
|
|
|
|
|
|
413
|
0
|
|
|
|
|
|
my $smime; |
|
414
|
0
|
|
|
|
|
|
eval{ $smime = Crypt::SMIME->new }; |
|
|
0
|
|
|
|
|
|
|
|
415
|
0
|
0
|
|
|
|
|
return( $self->error( "Failed to instantiate Crypt::SMIME: $@" ) ) if( $@ ); |
|
416
|
|
|
|
|
|
|
|
|
417
|
0
|
|
|
|
|
|
return( $smime ); |
|
418
|
|
|
|
|
|
|
} |
|
419
|
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
# _read_pem( $source ) → $pem_string |
|
421
|
|
|
|
|
|
|
# Accepts either a PEM string (contains '-----BEGIN') or a file path and returns the PEM |
|
422
|
|
|
|
|
|
|
# content as a string. Dies gracefully with a proper error. |
|
423
|
|
|
|
|
|
|
sub _read_pem |
|
424
|
|
|
|
|
|
|
{ |
|
425
|
0
|
|
|
0
|
|
|
my( $self, $source ) = @_; |
|
426
|
|
|
|
|
|
|
|
|
427
|
0
|
0
|
|
|
|
|
unless( defined( $source ) ) |
|
428
|
|
|
|
|
|
|
{ |
|
429
|
0
|
|
|
|
|
|
return( $self->error( '_read_pem(): undefined source.' ) ); |
|
430
|
|
|
|
|
|
|
} |
|
431
|
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
# Already a PEM string |
|
433
|
0
|
0
|
|
|
|
|
return( $source ) if( $source =~ /-----BEGIN/ ); |
|
434
|
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# File path |
|
436
|
0
|
0
|
|
|
|
|
unless( -f $source ) |
|
437
|
|
|
|
|
|
|
{ |
|
438
|
0
|
|
|
|
|
|
return( $self->error( "_read_pem(): file not found: $source" ) ); |
|
439
|
|
|
|
|
|
|
} |
|
440
|
|
|
|
|
|
|
|
|
441
|
0
|
0
|
|
|
|
|
unless( -r $source ) |
|
442
|
|
|
|
|
|
|
{ |
|
443
|
0
|
|
|
|
|
|
return( $self->error( "_read_pem(): file not readable: $source" ) ); |
|
444
|
|
|
|
|
|
|
} |
|
445
|
|
|
|
|
|
|
|
|
446
|
0
|
0
|
|
|
|
|
open( my $fh, '<', $source ) || |
|
447
|
|
|
|
|
|
|
return( $self->error( "_read_pem(): cannot open '$source': $!" ) ); |
|
448
|
0
|
|
|
|
|
|
local $/; |
|
449
|
0
|
|
|
|
|
|
my $pem = <$fh>; |
|
450
|
0
|
|
|
|
|
|
close( $fh ); |
|
451
|
|
|
|
|
|
|
|
|
452
|
0
|
0
|
0
|
|
|
|
unless( defined( $pem ) && $pem =~ /-----BEGIN/ ) |
|
453
|
|
|
|
|
|
|
{ |
|
454
|
0
|
|
|
|
|
|
return( $self->error( "_read_pem(): file '$source' does not contain PEM data." ) ); |
|
455
|
|
|
|
|
|
|
} |
|
456
|
|
|
|
|
|
|
|
|
457
|
0
|
|
|
|
|
|
return( $pem ); |
|
458
|
|
|
|
|
|
|
} |
|
459
|
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
# _serialise_for_smime( $mail_make_obj ) → $string |
|
461
|
|
|
|
|
|
|
# Serialises the Mail::Make object to a full RFC 2822 message string |
|
462
|
|
|
|
|
|
|
# (headers + body, CRLF line endings). |
|
463
|
|
|
|
|
|
|
# Unlike _serialise_for_gpg, we pass the COMPLETE message to Crypt::SMIME; it handles |
|
464
|
|
|
|
|
|
|
# RFC 5751 header separation internally. |
|
465
|
|
|
|
|
|
|
sub _serialise_for_smime |
|
466
|
|
|
|
|
|
|
{ |
|
467
|
0
|
|
|
0
|
|
|
my( $self, $mail ) = @_; |
|
468
|
|
|
|
|
|
|
|
|
469
|
0
|
0
|
|
|
|
|
unless( defined( $mail ) ) |
|
470
|
|
|
|
|
|
|
{ |
|
471
|
0
|
|
|
|
|
|
return( $self->error( '_serialise_for_smime(): no Mail::Make object supplied.' ) ); |
|
472
|
|
|
|
|
|
|
} |
|
473
|
|
|
|
|
|
|
|
|
474
|
0
|
0
|
|
|
|
|
unless( $mail->can( 'as_entity' ) ) |
|
475
|
|
|
|
|
|
|
{ |
|
476
|
0
|
|
|
|
|
|
return( $self->error( '_serialise_for_smime(): argument must be a Mail::Make object.' ) ); |
|
477
|
|
|
|
|
|
|
} |
|
478
|
|
|
|
|
|
|
|
|
479
|
0
|
|
0
|
|
|
|
my $entity = $mail->as_entity || return( $self->pass_error( $mail->error ) ); |
|
480
|
|
|
|
|
|
|
|
|
481
|
0
|
|
0
|
|
|
|
my $full = $entity->as_string || return( $self->pass_error( $entity->error ) ); |
|
482
|
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# Canonicalise line endings to CRLF |
|
484
|
0
|
|
|
|
|
|
$full =~ s/\015?\012/\015\012/g; |
|
485
|
|
|
|
|
|
|
|
|
486
|
0
|
|
|
|
|
|
return( $full ); |
|
487
|
|
|
|
|
|
|
} |
|
488
|
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
# STORABLE_freeze / STORABLE_thaw - satisfy Module::Generic serialisation hooks |
|
490
|
0
|
|
|
0
|
0
|
|
sub STORABLE_freeze { return( $_[0] ) } |
|
491
|
|
|
|
|
|
|
|
|
492
|
0
|
|
|
0
|
0
|
|
sub STORABLE_thaw { return( $_[0] ) } |
|
493
|
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# NOTE: package Mail::Make::SMIME::_RawEntity |
|
496
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
497
|
|
|
|
|
|
|
## Mail::Make::SMIME::_RawEntity |
|
498
|
|
|
|
|
|
|
## Lightweight entity wrapper for Crypt::SMIME output strings. |
|
499
|
|
|
|
|
|
|
## |
|
500
|
|
|
|
|
|
|
## Exposes just enough of the Mail::Make::Entity interface to satisfy |
|
501
|
|
|
|
|
|
|
## Mail::Make::smtpsend() and the test suite: |
|
502
|
|
|
|
|
|
|
## |
|
503
|
|
|
|
|
|
|
## headers->get( $name ) - returns the header value |
|
504
|
|
|
|
|
|
|
## headers->remove( $name ) - removes a header (no-op if absent) |
|
505
|
|
|
|
|
|
|
## as_string() - returns the complete RFC 2822 message verbatim |
|
506
|
|
|
|
|
|
|
## |
|
507
|
|
|
|
|
|
|
## We deliberately bypass Mail::Make::Entity because Entity::print_body() |
|
508
|
|
|
|
|
|
|
## branches on is_multipart() and iterates _parts. For a multipart/signed |
|
509
|
|
|
|
|
|
|
## entity the _parts array would be empty, producing a message with only a |
|
510
|
|
|
|
|
|
|
## closing boundary and no body. Storing the raw Crypt::SMIME string and |
|
511
|
|
|
|
|
|
|
## emitting it verbatim is the correct approach. |
|
512
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
513
|
|
|
|
|
|
|
# Hide it from CPAN |
|
514
|
|
|
|
|
|
|
package |
|
515
|
|
|
|
|
|
|
Mail::Make::SMIME::_RawEntity; |
|
516
|
|
|
|
|
|
|
|
|
517
|
2
|
|
|
2
|
|
17
|
use strict; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
50
|
|
|
518
|
2
|
|
|
2
|
|
8
|
use warnings; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
443
|
|
|
519
|
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
# new( \%headers, $raw_string ) → _RawEntity |
|
521
|
|
|
|
|
|
|
sub new |
|
522
|
|
|
|
|
|
|
{ |
|
523
|
0
|
|
|
0
|
|
|
my( $class, $hdrs_ref, $raw ) = @_; |
|
524
|
|
|
|
|
|
|
return( bless( |
|
525
|
|
|
|
|
|
|
{ |
|
526
|
0
|
|
|
|
|
|
_hdrs => { map { lc( $_ ) => $hdrs_ref->{ $_ } } keys( %$hdrs_ref ) }, |
|
|
0
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
_raw => $raw, |
|
528
|
|
|
|
|
|
|
}, $class ) ); |
|
529
|
|
|
|
|
|
|
} |
|
530
|
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
# as_string() → the complete RFC 2822 message string (CRLF line endings) |
|
532
|
0
|
|
|
0
|
|
|
sub as_string { return( $_[0]->{_raw} ) } |
|
533
|
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
# headers() → a _RawHeaders proxy object |
|
535
|
|
|
|
|
|
|
sub headers |
|
536
|
|
|
|
|
|
|
{ |
|
537
|
0
|
|
|
0
|
|
|
my $self = shift( @_ ); |
|
538
|
0
|
|
|
|
|
|
return( Mail::Make::SMIME::_RawHeaders->new( $self->{_hdrs} ) ); |
|
539
|
|
|
|
|
|
|
} |
|
540
|
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
# NOTE: package Mail::Make::SMIME::_RawHeaders |
|
542
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
543
|
|
|
|
|
|
|
## Mail::Make::SMIME::_RawHeaders |
|
544
|
|
|
|
|
|
|
## Minimal headers proxy used by _RawEntity. |
|
545
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
546
|
|
|
|
|
|
|
# Hide it from CPAN |
|
547
|
|
|
|
|
|
|
package |
|
548
|
|
|
|
|
|
|
Mail::Make::SMIME::_RawHeaders; |
|
549
|
|
|
|
|
|
|
|
|
550
|
2
|
|
|
2
|
|
14
|
use strict; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
57
|
|
|
551
|
2
|
|
|
2
|
|
7
|
use warnings; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
338
|
|
|
552
|
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
sub new |
|
554
|
|
|
|
|
|
|
{ |
|
555
|
0
|
|
|
0
|
|
|
my( $class, $hdrs_ref ) = @_; |
|
556
|
0
|
|
|
|
|
|
return( bless( { _h => $hdrs_ref }, $class ) ); |
|
557
|
|
|
|
|
|
|
} |
|
558
|
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
# get( $name ) → value string or undef |
|
560
|
|
|
|
|
|
|
sub get |
|
561
|
|
|
|
|
|
|
{ |
|
562
|
0
|
|
|
0
|
|
|
my( $self, $name ) = @_; |
|
563
|
0
|
|
|
|
|
|
return( $self->{_h}->{ lc( $name ) } ); |
|
564
|
|
|
|
|
|
|
} |
|
565
|
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
# remove( $name ) → removes the header (no-op if absent) |
|
567
|
|
|
|
|
|
|
sub remove |
|
568
|
|
|
|
|
|
|
{ |
|
569
|
0
|
|
|
0
|
|
|
my( $self, $name ) = @_; |
|
570
|
0
|
|
|
|
|
|
delete( $self->{_h}->{ lc( $name ) } ); |
|
571
|
0
|
|
|
|
|
|
return( $self ); |
|
572
|
|
|
|
|
|
|
} |
|
573
|
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
1; |
|
575
|
|
|
|
|
|
|
# NOTE: POD |
|
576
|
|
|
|
|
|
|
__END__ |
|
577
|
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=encoding utf-8 |
|
579
|
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
=head1 NAME |
|
581
|
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
Mail::Make::SMIME - S/MIME signing and encryption for Mail::Make (RFC 5751) |
|
583
|
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
585
|
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
use Mail::Make; |
|
587
|
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
my $mail = Mail::Make->new; |
|
589
|
|
|
|
|
|
|
$mail->from( 'jacques@example.com' ); |
|
590
|
|
|
|
|
|
|
$mail->to( 'recipient@example.com' ); |
|
591
|
|
|
|
|
|
|
$mail->subject( 'Signed message' ); |
|
592
|
|
|
|
|
|
|
$mail->plain( 'This message is signed.' ); |
|
593
|
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
# Sign only |
|
595
|
|
|
|
|
|
|
my $signed = $mail->smime_sign( |
|
596
|
|
|
|
|
|
|
Cert => '/path/to/my.cert.pem', |
|
597
|
|
|
|
|
|
|
Key => '/path/to/my.key.pem', |
|
598
|
|
|
|
|
|
|
) || die $mail->error; |
|
599
|
|
|
|
|
|
|
$signed->smtpsend( Host => 'smtp.example.com' ); |
|
600
|
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
# Encrypt only |
|
602
|
|
|
|
|
|
|
my $encrypted = $mail->smime_encrypt( |
|
603
|
|
|
|
|
|
|
RecipientCert => '/path/to/recipient.cert.pem', |
|
604
|
|
|
|
|
|
|
) || die $mail->error; |
|
605
|
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
# Sign then encrypt |
|
607
|
|
|
|
|
|
|
my $protected = $mail->smime_sign_encrypt( |
|
608
|
|
|
|
|
|
|
Cert => '/path/to/my.cert.pem', |
|
609
|
|
|
|
|
|
|
Key => '/path/to/my.key.pem', |
|
610
|
|
|
|
|
|
|
RecipientCert => '/path/to/recipient.cert.pem', |
|
611
|
|
|
|
|
|
|
) || die $mail->error; |
|
612
|
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
# Using the Mail::Make::SMIME object directly |
|
614
|
|
|
|
|
|
|
use Mail::Make::SMIME; |
|
615
|
|
|
|
|
|
|
my $smime = Mail::Make::SMIME->new( |
|
616
|
|
|
|
|
|
|
cert => '/path/to/my.cert.pem', |
|
617
|
|
|
|
|
|
|
key => '/path/to/my.key.pem', |
|
618
|
|
|
|
|
|
|
) || die Mail::Make::SMIME->error; |
|
619
|
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
my $signed = $smime->sign( entity => $mail ) || die $smime->error; |
|
621
|
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
=head1 VERSION |
|
623
|
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
v0.1.2 |
|
625
|
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
627
|
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
C<Mail::Make::SMIME> provides S/MIME signing, encryption, and combined sign-then-encrypt operations for L<Mail::Make> objects, following RFC 5751 (S/MIME Version 3.2). |
|
629
|
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
It delegates cryptographic operations to L<Crypt::SMIME>, which wraps the OpenSSL C<libcrypto> library. All certificates and keys must be supplied in PEM format, either as strings or as file paths. |
|
631
|
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
=head1 MEMORY USAGE AND LIMITATIONS |
|
633
|
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
=head2 In-memory processing |
|
635
|
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
All cryptographic operations performed by this module load the complete serialised message into memory before signing or encrypting it. This is a consequence of two factors: |
|
637
|
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
=over 4 |
|
639
|
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
=item 1. C<Crypt::SMIME> API |
|
641
|
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
L<Crypt::SMIME> accepts and returns plain Perl strings. It does not expose a streaming or filehandle-based interface. |
|
643
|
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
=item 2. Protocol constraints |
|
645
|
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
B<Signing> requires computing a cryptographic hash (e.g. SHA-256) over the entire content to be signed. Although the hash algorithm itself is sequential and could theoretically operate on a stream, the resulting C<multipart/signed> structure must carry the original content I<followed by> the detached signature. The signature cannot be emitted until the complete content has been hashed, which means either buffering the whole message in memory or reading it twice (once to hash, once to emit) - the latter requiring a temporary file. |
|
647
|
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
B<Encryption> uses a symmetric cipher (AES by default) operating on PKCS#7 C<EnvelopedData>. The ASN.1 DER encoding of C<EnvelopedData> declares the total length of the encrypted payload in the structure header, which must be known before the first byte is emitted. Streaming without a temporary file is therefore not possible with standard PKCS#7. |
|
649
|
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
=back |
|
651
|
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
=head2 Practical impact |
|
653
|
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
For typical email messages, such as plain text, HTML, and modest attachments, memory consumption is not a concern. Problems may arise with very large attachments (tens of megabytes or more). |
|
655
|
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
=head2 Future work |
|
657
|
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
A future C<v0.2.0> of C<Mail::Make::SMIME> may optionally delegate to the C<openssl smime> command-line tool via L<IPC::Run>, using temporary files, to support large messages without holding them in memory. This mirrors the approach already used by L<Mail::Make::GPG>. |
|
659
|
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
If in-memory processing is a concern for your use case, consider using L<Mail::Make::GPG> instead: OpenPGP uses I<partial body packets> (RFC 4880 §4.2.2) which allow true streaming without knowing the total message size in advance. |
|
661
|
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
|
663
|
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
=head2 new( %opts ) |
|
665
|
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
my $smime = Mail::Make::SMIME->new( |
|
667
|
|
|
|
|
|
|
cert => '/path/to/cert.pem', |
|
668
|
|
|
|
|
|
|
key => '/path/to/key.pem', |
|
669
|
|
|
|
|
|
|
key_password => 'secret', # or CODE ref |
|
670
|
|
|
|
|
|
|
ca_cert => '/path/to/ca.pem', |
|
671
|
|
|
|
|
|
|
); |
|
672
|
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
All options are optional at construction time and can be overridden per method call. |
|
674
|
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=head1 METHODS |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=head2 ca_cert( [$pem_or_path] ) |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
Gets or sets the CA certificate used for signature verification. |
|
680
|
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
=head2 cert( [$pem_or_path] ) |
|
682
|
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
Gets or sets the signer certificate. |
|
684
|
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=head2 encrypt( entity => $mail, RecipientCert => $cert [, %opts] ) |
|
686
|
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
Encrypts C<$mail> for one or more recipients. Returns a new L<Mail::Make> object whose entity is a C<application/pkcs7-mime; smime-type=enveloped-data> message. |
|
688
|
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
C<RecipientCert> may be a PEM string, a file path, or an array reference of either, for multi-recipient encryption. |
|
690
|
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
=head2 key( [$pem_or_path] ) |
|
692
|
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
Gets or sets the private key. |
|
694
|
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
=head2 key_password( [$string_or_coderef] ) |
|
696
|
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
Gets or sets the private key passphrase. |
|
698
|
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
=head2 sign( entity => $mail [, %opts] ) |
|
700
|
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
Signs C<$mail> with a detached S/MIME signature and returns a new L<Mail::Make> object whose entity is a C<multipart/signed> message. |
|
702
|
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
The signature is always detached (C<smime-type=signed-data> with C<Content-Type: multipart/signed>), which allows non-S/MIME-aware clients to read the message body. |
|
704
|
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
Options (all override constructor defaults): |
|
706
|
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=over 4 |
|
708
|
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=item Cert => $pem_string_or_path |
|
710
|
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
Signer certificate in PEM format. |
|
712
|
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=item Key => $pem_string_or_path |
|
714
|
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
Private key in PEM format. |
|
716
|
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=item KeyPassword => $string_or_coderef |
|
718
|
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
Passphrase for an encrypted private key, or a CODE ref that returns one. |
|
720
|
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=item CACert => $pem_string_or_path |
|
722
|
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
CA certificate(s) to include in the signature for chain verification. |
|
724
|
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
=back |
|
726
|
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
=head2 sign_encrypt( entity => $mail, RecipientCert => $cert [, %opts] ) |
|
728
|
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
Signs C<$mail> then encrypts the signed result. Accepts all options of both L</sign> and L</encrypt>. |
|
730
|
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
|
732
|
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
L<Crypt::SMIME> (XS module wrapping OpenSSL C<libcrypto>). |
|
734
|
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
736
|
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
L<Mail::Make>, L<Mail::Make::GPG>, L<Crypt::SMIME> |
|
738
|
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
RFC 5751 - Secure/Multipurpose Internet Mail Extensions (S/MIME) Version 3.2 |
|
740
|
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
RFC 4880 - OpenPGP Message Format (partial body length packets, §4.2.2) |
|
742
|
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
RFC 5652 - Cryptographic Message Syntax (CMS / PKCS#7 EnvelopedData) |
|
744
|
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=head1 AUTHOR |
|
746
|
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt> |
|
748
|
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
|
750
|
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
Copyright(c) 2026 DEGUEST Pte. Ltd. |
|
752
|
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
All rights reserved. |
|
754
|
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
|
756
|
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
=cut |