File Coverage

lib/Mail/Make/SMIME.pm
Criterion Covered Total %
statement 33 228 14.4
branch 0 96 0.0
condition 0 72 0.0
subroutine 11 35 31.4
pod 8 10 80.0
total 52 441 11.7


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