Master to 4.2.8
[usit-rt.git] / lib / RT / Crypt.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
6 #                                          <sales@bestpractical.com>
7 #
8 # (Except where explicitly superseded by other copyright notices)
9 #
10 #
11 # LICENSE:
12 #
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
16 # from www.gnu.org.
17 #
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21 # General Public License for more details.
22 #
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
28 #
29 #
30 # CONTRIBUTION SUBMISSION POLICY:
31 #
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
37 #
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
46 #
47 # END BPS TAGGED BLOCK }}}
48
49 use strict;
50 use warnings;
51
52 package RT::Crypt;
53 use 5.010;
54
55 =head1 NAME
56
57 RT::Crypt - encrypt/decrypt and sign/verify subsystem for RT
58
59 =head1 DESCRIPTION
60
61 This module provides support for encryption and signing of outgoing
62 messages, as well as the decryption and verification of incoming emails
63 using various encryption standards. Currently, L<GnuPG|RT::Crypt::GnuPG>
64 and L<SMIME|RT::Crypt::SMIME> protocols are supported.
65
66 =head1 CONFIGURATION
67
68 You can control the configuration of this subsystem from RT's configuration file.
69 Some options are available via the web interface, but to enable this functionality,
70 you MUST start in the configuration file.
71
72 For each protocol there is a hash with the same name in the configuration file.
73 This hash controls RT-specific options regarding the protocol. It allows you to
74 enable/disable each facility or change the format of messages; for example, GnuPG
75 uses the following config:
76
77     Set( %GnuPG,
78         Enable => 1,
79         ... other options ...
80     );
81
82 C<Enable> is the only key that is generic for all protocols. A protocol may have
83 additional options to fine-tune behaviour.
84
85 However, note that you B<must> add the
86 L<Auth::Crypt|RT::Interface::Email::Auth::Crypt> email filter to enable
87 the handling of incoming encrypted/signed messages.  It should be added
88 in addition to the standard
89 L<Auth::MailFrom|RT::Interface::Email::Auth::Crypt> plugin.
90
91 =head2 %Crypt
92
93 This config option hash chooses which protocols are decrypted and
94 verified in incoming messages, which protocol is used for outgoing
95 emails, and RT's behaviour on errors during decrypting and verification.
96
97 RT will provide sane defaults for all of these options.  By default, all
98 enabled encryption protocols are decrypted on incoming mail; if you wish
99 to limit this to a subset, you may, via:
100
101     Set( %Crypt,
102         ...
103         Incoming => ['SMIME'],
104         ...
105     );
106
107 RT can currently only use one protocol to encrypt and sign outgoing
108 email; this defaults to the first enabled protocol.  You many specify it
109 explicitly via:
110
111     Set( %Crypt,
112         ...
113         Outgoing => 'GnuPG',
114         ...
115     );
116
117 You can allow users to encrypt data in the database by setting the
118 C<AllowEncryptDataInDB> key to a true value; by default, this is
119 disabled.  Be aware that users must have rights to see and modify
120 tickets to use this feature.
121
122 =head2 Per-queue options
123
124 Using the web interface, it is possible to enable signing and/or
125 encrypting by default. As an administrative user of RT, navigate to the
126 'Admin' and 'Queues' menus, and select a queue.  If at least one
127 encryption protocol is enabled, information concerning available keys
128 will be displayed, as well as options to enable signing and encryption.
129
130 =head2 Handling incoming messages
131
132 To enable handling of encrypted and signed message in the RT you must
133 enable the L<RT::Interface::Email::Auth::Crypt> mail plugin:
134
135     Set(@MailPlugins, 'Auth::MailFrom', 'Auth::Crypt', ...other filter...);
136
137 =head2 Error handling
138
139 There are several global templates created in the database by
140 default. RT uses these templates to send error messages to users or RT's
141 owner. These templates have an 'Error:' or 'Error to RT owner:' prefix
142 in the name. You can adjust the text of the messages using the web
143 interface.
144
145 Note that while C<$TicketObj>, C<$TransactionObj> and other variables
146 usually available in RT's templates are not available in these
147 templates, but each is passed alternate data structures can be used to
148 build better messages; see the default templates and descriptions below.
149
150 You can disable any particular notification by simply deleting the
151 content of a template.  Deleting the templates entirely is not
152 suggested, as RT will log error messages when attempting to send mail
153 usign them.
154
155 =head3 Problems with public keys
156
157 The 'Error: public key' template is used to inform the user that RT had
158 problems with their public key, and thus will not be able to send
159 encrypted content. There are several reasons why RT might fail to use a
160 key; by default, the actual reason is not sent to the user, but sent to
161 the RT owner using the 'Error to RT owner: public key' template.
162
163 Possible reasons include "Not Found", "Ambiguous specification", "Wrong
164 key usage", "Key revoked", "Key expired", "No CRL known", "CRL too old",
165 "Policy mismatch", "Not a secret key", "Key not trusted" or "No specific
166 reason given".
167
168 In the 'Error: public key' template there are a few additional variables
169 available:
170
171 =over 4
172
173 =item $Message - user friendly error message
174
175 =item $Reason - short reason as listed above
176
177 =item $Recipient - recipient's identification
178
179 =item $AddressObj - L<Email::Address> object containing recipient's email address
180
181 =back
182
183 As a message may have several invalid recipients, to avoid sending many
184 emails to the RT owner, the system sends one message to the owner,
185 grouped by recipient. In the 'Error to RT owner: public key' template a
186 C<@BadRecipients> array is available where each element is a hash
187 reference that describes one recipient using the same fields as
188 described above:
189
190     @BadRecipients = (
191         { Message => '...', Reason => '...', Recipient => '...', ...},
192         { Message => '...', Reason => '...', Recipient => '...', ...},
193         ...
194     )
195
196 =head3 Private key doesn't exist
197
198 The 'Error: no private key' template is used to inform the user that
199 they sent an encrypted email to RT, but RT does not have the private key
200 to decrypt it.
201
202 In this template L<MIME::Entity> object C<$Message> is available, which
203 is the originally received message.
204
205 =head3 Invalid data
206
207 The 'Error: bad encrypted data' template is used to inform the user that
208 a message they sent had invalid data, and could not be handled.  There
209 are several possible reasons for this error, but most of them are data
210 corruption or absence of expected information.
211
212 In this template, the C<@Messages> array is available, and will contain
213 a list of error messages.
214
215 =head1 METHODS
216
217 =head2 Protocols
218
219 Returns the complete set of encryption protocols that RT implements; not
220 all may be supported by this installation.
221
222 =cut
223
224 our @PROTOCOLS = ('GnuPG', 'SMIME');
225 our %PROTOCOLS = map { lc $_ => $_ } @PROTOCOLS;
226
227 sub Protocols {
228     return @PROTOCOLS;
229 }
230
231 =head2 EnabledProtocols
232
233 Returns the set of enabled and available encryption protocols.
234
235 =cut
236
237 sub EnabledProtocols {
238     my $self = shift;
239     return grep RT->Config->Get($_)->{'Enable'}, $self->Protocols;
240 }
241
242 =head2 UseForOutgoing
243
244 Returns the configured outgoing encryption protocol; see
245 L<RT_Config/Crypt>.
246
247 =cut
248
249 sub UseForOutgoing {
250     return RT->Config->Get('Crypt')->{'Outgoing'};
251 }
252
253 =head2 EnabledOnIncoming
254
255 Returns the list of encryption protocols that should be used for
256 decryption and verification of incoming email; see L<RT_Config/Crypt>.
257 This list is irrelevant unless L<RT::Interface::Email::Auth::Crypt> is
258 enabled in L<RT_Config/@MailPlugins>.
259
260 =cut
261
262 sub EnabledOnIncoming {
263     return @{ scalar RT->Config->Get('Crypt')->{'Incoming'} };
264 }
265
266 =head2 LoadImplementation CLASS
267
268 Given the name of an encryption implementation (e.g. "GnuPG"), loads the
269 L<RT::Crypt> class associated with it; return the classname on success,
270 and undef on failure.
271
272 =cut
273
274 sub LoadImplementation {
275     state %cache;
276     my $proto = $PROTOCOLS{ lc $_[1] } or die "Unknown protocol '$_[1]'";
277     my $class = 'RT::Crypt::'. $proto;
278     return $cache{ $class } if exists $cache{ $class };
279
280     if ($class->require) {
281         return $cache{ $class } = $class;
282     } else {
283         RT->Logger->warn( "Could not load $class: $@" );
284         return $cache{ $class } = undef;
285     }
286 }
287
288 =head2 SimpleImplementationCall Protocol => NAME, [...]
289
290 Examines the caller of this method, and dispatches to the method of the
291 same name on the correct L<RT::Crypt::Role> class based on the provided
292 C<Protocol>.
293
294 =cut
295
296 sub SimpleImplementationCall {
297     my $self = shift;
298     my %args = (@_);
299     my $protocol = delete $args{'Protocol'} || $self->UseForOutgoing;
300
301     my $method = (caller(1))[3];
302     $method =~ s/.*:://;
303
304     my %res = $self->LoadImplementation( $protocol )->$method( %args );
305     $res{'Protocol'} = $protocol if keys %res;
306     return %res;
307 }
308
309 =head2 FindProtectedParts Entity => MIME::Entity
310
311 Looks for encrypted or signed parts of the given C<Entity>, using all
312 L</EnabledOnIncoming> encryption protocols.  For each node in the MIME
313 hierarchy, L<RT::Crypt::Role/CheckIfProtected> for that L<MIME::Entity>
314 is called on each L</EnabledOnIncoming> protocol.  Any multipart nodes
315 not claimed by those protocols are recursed into.
316
317 Finally, L<RT::Crypt::Role/FindScatteredParts> is called on the top-most
318 entity for each L</EnabledOnIncoming> protocol.
319
320 Returns a list of hash references; each hash reference is guaranteed to
321 contain a C<Protocol> key describing the protocol of the found part, and
322 a C<Type> which is either C<encrypted> or C<signed>.  The remaining keys
323 are protocol-dependent; the hashref will be provided to
324 L</VerifyDecrypt>.
325
326 =cut
327
328 sub FindProtectedParts {
329     my $self = shift;
330     my %args = (
331         Entity => undef,
332         Skip => {},
333         Scattered => 1,
334         @_
335     );
336
337     my $entity = $args{'Entity'};
338     return () if $args{'Skip'}{ $entity };
339
340     $args{'TopEntity'} ||= $entity;
341
342     my @protocols = $self->EnabledOnIncoming;
343
344     foreach my $protocol ( @protocols ) {
345         my $class = $self->LoadImplementation( $protocol );
346         my %info = $class->CheckIfProtected(
347             TopEntity => $args{'TopEntity'},
348             Entity    => $entity,
349         );
350         next unless keys %info;
351
352         $args{'Skip'}{ $entity } = 1;
353         $info{'Protocol'} = $protocol;
354         return \%info;
355     }
356
357     if ( $entity->effective_type =~ /^multipart\/(?:signed|encrypted)/ ) {
358         # if no module claimed that it supports these types then
359         # we don't dive in and check sub-parts
360         $args{'Skip'}{ $entity } = 1;
361         return ();
362     }
363
364     my @res;
365
366     # not protected itself, look inside
367     push @res, $self->FindProtectedParts(
368         %args, Entity => $_, Scattered => 0,
369     ) foreach grep !$args{'Skip'}{$_}, $entity->parts;
370
371     if ( $args{'Scattered'} ) {
372         my %parent;
373         my $filter; $filter = sub {
374             $parent{$_[0]} = $_[1];
375             unless ( $_[0]->is_multipart ) {
376                 return () if $args{'Skip'}{$_[0]};
377                 return $_[0];
378             }
379             return map $filter->($_, $_[0]), grep !$args{'Skip'}{$_}, $_[0]->parts;
380         };
381         my @parts = $filter->($entity);
382         return @res unless @parts;
383
384         foreach my $protocol ( @protocols ) {
385             my $class = $self->LoadImplementation( $protocol );
386             my @list = $class->FindScatteredParts(
387                 Entity  => $args{'TopEntity'},
388                 Parts   => \@parts,
389                 Parents => \%parent,
390                 Skip    => $args{'Skip'}
391             );
392             next unless @list;
393
394             $_->{'Protocol'} = $protocol foreach @list;
395             push @res, @list;
396             @parts = grep !$args{'Skip'}{$_}, @parts;
397         }
398     }
399
400     return @res;
401 }
402
403 =head2 SignEncrypt Entity => ENTITY, [Sign => 1], [Encrypt => 1],
404 [Recipients => ARRAYREF], [Signer => NAME], [Protocol => NAME],
405 [Passphrase => VALUE]
406
407 Takes a L<MIME::Entity> object, and signs and/or encrypts it using the
408 given C<Protocol>.  If not set, C<Recipients> for encryption will be set
409 by examining the C<To>, C<Cc>, and C<Bcc> headers of the MIME entity.
410 If not set, C<Signer> defaults to the C<From> of the MIME entity.
411
412 C<Passphrase>, if not provided, will be retrieved using
413 L<RT::Crypt::Role/GetPassphrase>.
414
415 Returns a hash with at least the following keys:
416
417 =over
418
419 =item exit_code
420
421 True if there was an error encrypting or signing.
422
423 =item message
424
425 An un-localized error message desribing the problem.
426
427 =back
428
429 =cut
430
431 sub SignEncrypt {
432     my $self = shift;
433     my %args = (@_);
434
435     my $entity = $args{'Entity'};
436     if ( $args{'Sign'} && !defined $args{'Signer'} ) {
437         $args{'Signer'} =
438             $self->UseKeyForSigning
439             || do {
440                 my ($addr) = map {Email::Address->parse( Encode::decode( "UTF-8", $_ ) )}
441                     $entity->head->get( 'From' );
442                 $addr ? $addr->address : undef
443             };
444     }
445     if ( $args{'Encrypt'} && !$args{'Recipients'} ) {
446         my %seen;
447         $args{'Recipients'} = [
448             grep $_ && !$seen{ $_ }++, map $_->address,
449             map Email::Address->parse( Encode::decode("UTF-8", $_ ) ),
450             map $entity->head->get( $_ ),
451             qw(To Cc Bcc)
452         ];
453     }
454     return $self->SimpleImplementationCall( %args );
455 }
456
457 =head2 SignEncryptContent Content => STRINGREF, [Sign => 1], [Encrypt => 1],
458 [Recipients => ARRAYREF], [Signer => NAME], [Protocol => NAME],
459 [Passphrase => VALUE]
460
461 Signs and/or encrypts a string, which is passed by reference.
462 C<Recipients> defaults to C</UseKeyForSigning>, and C<Recipients>
463 defaults to the global L<RT::Config/CorrespondAddress>.  All other
464 arguments and return values are identical to L</SignEncrypt>.
465
466 =cut
467
468 sub SignEncryptContent {
469     my $self = shift;
470     my %args = (@_);
471
472     if ( $args{'Sign'} && !defined $args{'Signer'} ) {
473         $args{'Signer'} = $self->UseKeyForSigning;
474     }
475     if ( $args{'Encrypt'} && !$args{'Recipients'} ) {
476         $args{'Recipients'} = [ RT->Config->Get('CorrespondAddress') ];
477     }
478
479     return $self->SimpleImplementationCall( %args );
480 }
481
482 =head2 DrySign Signer => KEY
483
484 Signs a small message with the key, to make sure the key exists and we
485 have a useable passphrase. The Signer argument MUST be a key identifier
486 of the signer: either email address, key id or finger print.
487
488 Returns a true value if all went well.
489
490 =cut
491
492 sub DrySign {
493     my $self = shift;
494
495     my $mime = MIME::Entity->build(
496         Type    => "text/plain",
497         From    => 'nobody@localhost',
498         To      => 'nobody@localhost',
499         Subject => "dry sign",
500         Data    => ['t'],
501     );
502
503     my %res = $self->SignEncrypt(
504         @_,
505         Sign    => 1,
506         Encrypt => 0,
507         Entity  => $mime,
508     );
509
510     return $res{exit_code} == 0;
511 }
512
513 =head2 VerifyDecrypt Entity => ENTITY [, Passphrase => undef ]
514
515 Locates all protected parts of the L<MIME::Entity> object C<ENTITY>, as
516 found by L</FindProtectedParts>, and calls
517 L<RT::Crypt::Role/VerifyDecrypt> from the appropriate L<RT::Crypt::Role>
518 class on each.
519
520 C<Passphrase>, if not provided, will be retrieved using
521 L<RT::Crypt::Role/GetPassphrase>.
522
523 Returns a list of the hash references returned from
524 L<RT::Crypt::Role/VerifyDecrypt>.
525
526 =cut
527
528 sub VerifyDecrypt {
529     my $self = shift;
530     my %args = (
531         Entity    => undef,
532         Recursive => 1,
533         @_
534     );
535
536     my @res;
537
538     my @protected = $self->FindProtectedParts( Entity => $args{'Entity'} );
539     foreach my $protected ( @protected ) {
540         my %res = $self->SimpleImplementationCall(
541             %args, Protocol => $protected->{'Protocol'}, Info => $protected
542         );
543
544         # Let the header be modified so continuations are handled
545         my $modify = $res{status_on}->head->modify;
546         $res{status_on}->head->modify(1);
547         $res{status_on}->head->add(
548             "X-RT-" . $protected->{'Protocol'} . "-Status" => $res{'status'}
549         );
550         $res{status_on}->head->modify($modify);
551
552         push @res, \%res;
553     }
554
555     push @res, $self->VerifyDecrypt( %args )
556         if $args{Recursive} and @res and not grep {$_->{'exit_code'}} @res;
557
558     return @res;
559 }
560
561 =head2 DecryptContent Protocol => NAME, Content => STRINGREF, [Passphrase => undef]
562
563 Decrypts the content in the string reference in-place.  All other
564 arguments and return values are identical to L</VerifyDecrypt>.
565
566 =cut
567
568 sub DecryptContent {
569     return shift->SimpleImplementationCall( @_ );
570 }
571
572 =head2 ParseStatus Protocol => NAME, Status => STRING
573
574 Takes a C<String> describing the status of verification/decryption,
575 usually as stored in a MIME header.  Parses it and returns array of hash
576 references, one for each operation.  Each hashref contains at least
577 three keys:
578
579 =over
580
581 =item Operation
582
583 The classification of the process whose status is being reported upon.
584 Valid values include C<Sign>, C<Encrypt>, C<Decrypt>, C<Verify>,
585 C<PassphraseCheck>, C<RecipientsCheck> and C<Data>.
586
587 =item Status
588
589 Whether the operation was successful; contains C<DONE> on success.
590 Other possible values include C<ERROR>, C<BAD>, or C<MISSING>.
591
592 =item Message
593
594 An un-localized user friendly message.
595
596 =back
597
598 =cut
599
600 sub ParseStatus {
601     my $self = shift;
602     my %args = (
603         Protocol => undef,
604         Status   => '',
605         @_
606     );
607     return $self->LoadImplementation( $args{'Protocol'} )->ParseStatus( $args{'Status'} );
608 }
609
610 =head2 UseKeyForSigning [KEY]
611
612 Returns or sets the identifier of the key that should be used for
613 signing.  Returns the current value when called without arguments; sets
614 the new value when called with one argument and unsets if it's undef.
615
616 This cache is cleared at the end of every request.
617
618 =cut
619
620 sub UseKeyForSigning {
621     my $self = shift;
622     state $key;
623     if ( @_ ) {
624         $key = $_[0];
625     }
626     return $key;
627 }
628
629 =head2 UseKeyForEncryption [KEY [, VALUE]]
630
631 Gets or sets keys to use for encryption.  When passed no arguments,
632 clears the cache.  When passed just a key, returns the encryption key
633 previously stored for that key.  When passed two (or more) keys, stores
634 them associatively.
635
636 This cache is reset at the end of every request.
637
638 =cut
639
640 sub UseKeyForEncryption {
641     my $self = shift;
642     state %key;
643     unless ( @_ ) {
644         %key = ();
645     } elsif ( @_ > 1 ) {
646         %key = (%key, @_);
647         $key{ lc($_) } = delete $key{ $_ } foreach grep lc ne $_, keys %key;
648     } else {
649         return $key{ $_[0] };
650     }
651     return ();
652 }
653
654 =head2 GetKeysForEncryption Recipient => EMAIL, Protocol => NAME
655
656 Returns the list of keys which are suitable for encrypting mail to the
657 given C<Recipient>.  Generally this is equivalent to L</GetKeysInfo>
658 with a C<Type> of <private>, but encryption protocols may further limit
659 which keys can be used for encryption, as opposed to signing.
660
661 =cut
662
663 sub CheckRecipients {
664     my $self = shift;
665     my @recipients = (@_);
666
667     my ($status, @issues) = (1, ());
668
669     my $trust = sub { 1 };
670     if ( $self->UseForOutgoing eq 'SMIME' ) {
671         $trust = sub { $_[0]->{'TrustLevel'} > 0 or RT->Config->Get('SMIME')->{AcceptUntrustedCAs} };
672     } elsif ( $self->UseForOutgoing eq 'GnuPG' ) {
673         $trust = sub { $_[0]->{'TrustLevel'} > 0 };
674     }
675
676     my %seen;
677     foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) {
678         my %res = $self->GetKeysForEncryption( Recipient => $address );
679         if ( $res{'info'} && @{ $res{'info'} } == 1 and $trust->($res{'info'}[0]) ) {
680             # One key, which is trusted, or we can sign with an
681             # untrusted key (aka SMIME with AcceptUntrustedCAs)
682             next;
683         }
684         my $user = RT::User->new( RT->SystemUser );
685         $user->LoadByEmail( $address );
686         # it's possible that we have no User record with the email
687         $user = undef unless $user->id;
688
689         if ( my $fpr = RT::Crypt->UseKeyForEncryption( $address ) ) {
690             if ( $res{'info'} && @{ $res{'info'} } ) {
691                 next if
692                     grep lc $_->{'Fingerprint'} eq lc $fpr,
693                     grep $trust->($_),
694                     @{ $res{'info'} };
695             }
696
697             $status = 0;
698             my %issue = (
699                 EmailAddress => $address,
700                 $user? (User => $user) : (),
701                 Keys => undef,
702             );
703             $issue{'Message'} = "Selected key either is not trusted or doesn't exist anymore."; #loc
704             push @issues, \%issue;
705             next;
706         }
707
708         my $prefered_key;
709         $prefered_key = $user->PreferredKey if $user;
710         #XXX: prefered key is not yet implemented...
711
712         # classify errors
713         $status = 0;
714         my %issue = (
715             EmailAddress => $address,
716             $user? (User => $user) : (),
717             Keys => undef,
718         );
719
720         unless ( $res{'info'} && @{ $res{'info'} } ) {
721             # no key
722             $issue{'Message'} = "There is no key suitable for encryption."; #loc
723         }
724         elsif ( @{ $res{'info'} } == 1 && !$res{'info'}[0]{'TrustLevel'} ) {
725             # trust is not set
726             $issue{'Message'} = "There is one suitable key, but trust level is not set."; #loc
727         }
728         else {
729             # multiple keys
730             $issue{'Message'} = "There are several keys suitable for encryption."; #loc
731         }
732         push @issues, \%issue;
733     }
734     return ($status, @issues);
735 }
736
737 sub GetKeysForEncryption {
738     my $self = shift;
739     my %args = @_%2? (Recipient => @_) : (Protocol => undef, Recipient => undef, @_ );
740     return $self->SimpleImplementationCall( %args );
741 }
742
743 =head2 GetKeysForSigning Signer => EMAIL, Protocol => NAME
744
745 Returns the list of keys which are suitable for signing mail from the
746 given C<Signer>.  Generally this is equivalent to L</GetKeysInfo>
747 with a C<Type> of <private>, but encryption protocols may further limit
748 which keys can be used for signing, as opposed to encryption.
749
750 =cut
751
752 sub GetKeysForSigning {
753     my $self = shift;
754     my %args = @_%2? (Signer => @_) : (Protocol => undef, Signer => undef, @_);
755     return $self->SimpleImplementationCall( %args );
756 }
757
758 =head2 GetPublicKeyInfo Protocol => NAME, KEY => EMAIL
759
760 As per L</GetKeyInfo>, but the C<Type> is forced to C<public>.
761
762 =cut
763
764 sub GetPublicKeyInfo {
765     return (shift)->GetKeyInfo( @_, Type => 'public' );
766 }
767
768 =head2 GetPrivateKeyInfo Protocol => NAME, KEY => EMAIL
769
770 As per L</GetKeyInfo>, but the C<Type> is forced to C<private>.
771
772 =cut
773
774 sub GetPrivateKeyInfo {
775     return (shift)->GetKeyInfo( @_, Type => 'private' );
776 }
777
778 =head2 GetKeyInfo Protocol => NAME, Type => ('public'|'private'), KEY => EMAIL
779
780 As per L</GetKeysInfo>, but only the first matching key is returned in
781 the C<info> value of the result.
782
783 =cut
784
785 sub GetKeyInfo {
786     my $self = shift;
787     my %res = $self->GetKeysInfo( @_ );
788     $res{'info'} = $res{'info'}->[0];
789     return %res;
790 }
791
792 =head2 GetKeysInfo Protocol => NAME, Type => ('public'|'private'), Key => EMAIL
793
794 Looks up information about the public or private keys (as determined by
795 C<Type>) for the email address C<Key>.  As each protocol has its own key
796 store, C<Protocol> is also required.  If no C<Key> is provided and a
797 true value for C<Force> is given, returns all keys.
798
799 The return value is a hash containing C<exit_code> and C<message> in the
800 case of failure, or C<info>, which is an array reference of key
801 information.  Each key is represented as a hash reference; the keys are
802 protocol-dependent, but will at least contain:
803
804 =over
805
806 =item Protocol
807
808 The name of the protocol of this key
809
810 =item Created
811
812 An L<RT::Date> of the date the key was created; undef if unset.
813
814 =item Expire
815
816 An L<RT::Date> of the date the key expires; undef if the key does not expire.
817
818 =item Fingerprint
819
820 A fingerprint unique to this key
821
822 =item User
823
824 An array reference of associated user data, each of which is a hashref
825 containing at least a C<String> value, which is a C<< Alice Example
826 <alice@example.com> >> style email address.  Each may also contain
827 C<Created> and C<Expire> keys, which are L<RT::Date> objects.
828
829 =back
830
831 =cut
832
833 sub GetKeysInfo {
834     my $self = shift;
835     my %args = @_%2 ? (Key => @_) : ( Protocol => undef, Key => undef, @_ );
836     return $self->SimpleImplementationCall( %args );
837 }
838
839 1;