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