]>
Commit | Line | Data |
---|---|---|
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::Role; | |
53 | use Role::Basic; | |
54 | ||
55 | =head1 NAME | |
56 | ||
57 | RT::Crypt::Role - Common requirements for encryption implementations | |
58 | ||
59 | =head1 METHODS | |
60 | ||
61 | =head2 Probe | |
62 | ||
63 | This routine is called only if the protocol is enabled, and should | |
64 | return true if all binaries required by the protocol are installed. It | |
65 | should produce any warnings necessary to describe any issues it | |
66 | encounters. | |
67 | ||
68 | =cut | |
69 | ||
70 | requires 'Probe'; | |
71 | ||
72 | =head2 GetPassphrase Address => ADDRESS | |
73 | ||
74 | Returns the passphrase for the given address. It looks at the relevant | |
75 | configuration option for the encryption protocol | |
76 | (e.g. L<RT_Config/GnuPG> for GnuPG), and examines the Passphrase key. | |
77 | It it does not exist, returns the empty string. If it is a scalar, it | |
78 | returns that value. If it is an anonymous subroutine, it calls it. If | |
79 | it is a hash, it looks up the address (using '' as a fallback key). | |
80 | ||
81 | =cut | |
82 | ||
83 | sub GetPassphrase { | |
84 | my $self = shift; | |
85 | my %args = ( Address => undef, @_ ); | |
86 | ||
87 | my $class = ref($self) || $self; | |
88 | $class =~ s/^RT::Crypt:://; | |
89 | ||
90 | my $config = RT->Config->Get($class)->{Passphrase}; | |
91 | ||
92 | return '' unless defined $config; | |
93 | ||
94 | if (not ref $config) { | |
95 | return $config; | |
96 | } elsif (ref $config eq "HASH") { | |
97 | return $config->{$args{Address}} | |
98 | || $config->{''}; | |
99 | } elsif (ref $config eq "CODE") { | |
100 | return $config->( @_ ); | |
101 | } else { | |
102 | warn "Unknown Passphrase type for $class: ".ref($config); | |
103 | } | |
104 | } | |
105 | ||
106 | =head2 SignEncrypt Entity => MIME::Entity, [ Encrypt => 1, Sign => 1, ... ] | |
107 | ||
108 | Signs and/or encrypts a MIME entity. All arguments and return values | |
109 | are identical to L<RT::Crypt/SignEncrypt>, with the omission of | |
110 | C<Protocol>. | |
111 | ||
112 | =cut | |
113 | ||
114 | requires 'SignEncrypt'; | |
115 | ||
116 | =head2 SignEncryptContent Content => STRINGREF, [ Encrypt => 1, Sign => 1, ... ] | |
117 | ||
118 | Signs and/or encrypts a string, which is passed by reference. All | |
119 | arguments and return values are identical to | |
120 | L<RT::Crypt/SignEncryptContent>, with the omission of C<Protocol>. | |
121 | ||
122 | =cut | |
123 | ||
124 | requires 'SignEncryptContent'; | |
125 | ||
126 | =head2 VerifyDecrypt Info => HASHREF, [ Passphrase => undef ] | |
127 | ||
128 | The C<Info> key is a hashref as returned from L</FindScatteredParts> or | |
129 | L</CheckIfProtected>. This method should alter the mime objects | |
130 | in-place as necessary during signing and decryption. | |
131 | ||
132 | Returns a hash with at least the following keys: | |
133 | ||
134 | =over | |
135 | ||
136 | =item exit_code | |
137 | ||
138 | True if there was an error encrypting or signing. | |
139 | ||
140 | =item message | |
141 | ||
142 | An un-localized error message desribing the problem. | |
143 | ||
144 | =back | |
145 | ||
146 | =cut | |
147 | ||
148 | requires 'VerifyDecrypt'; | |
149 | ||
150 | =head2 DecryptContent Content => STRINGREF, [ Passphrase => undef ] | |
151 | ||
152 | Decrypts the content in the string reference in-place. All arguments | |
153 | and return values are identical to L<RT::Crypt/DecryptContent>, with the | |
154 | omission of C<Protocol>. | |
155 | ||
156 | =cut | |
157 | ||
158 | requires 'DecryptContent'; | |
159 | ||
160 | =head2 ParseStatus STRING | |
161 | ||
162 | Takes a string describing the status of verification/decryption, usually | |
163 | as stored in a MIME header. Parses and returns it as described in | |
164 | L<RT::Crypt/ParseStatus>. | |
165 | ||
166 | =cut | |
167 | ||
168 | requires 'ParseStatus'; | |
169 | ||
170 | =head2 FindScatteredParts Parts => ARRAYREF, Parents => HASHREF, Skip => HASHREF | |
171 | ||
172 | Passed the list of unclaimed L<MIME::Entity> objects in C<Parts>, this | |
173 | method should examine them as a whole to determine if there are any that | |
174 | could not be claimed by the single-entity-at-a-time L</CheckIfProtected> | |
175 | method. This is generally only necessary in the case of signatures | |
176 | manually attached in parallel, and the like. | |
177 | ||
178 | If found, the relevant entities should be inserted into C<Skip> with a | |
179 | true value, to signify to other encryption protols that they have been | |
180 | claimed. The method should return a list of hash references, each | |
181 | containing a C<Type> key which is either C<signed> or C<encrypted>. The | |
182 | remaining keys are protocol-dependent; the hashref will be provided to | |
183 | L</VerifyDecrypt>. | |
184 | ||
185 | =cut | |
186 | ||
187 | requires 'FindScatteredParts'; | |
188 | ||
189 | =head2 CheckIfProtected Entity => MIME::Entity | |
190 | ||
191 | Examines the provided L<MIME::Entity>, and returns an empty list if it | |
192 | is not signed or encrypted using the protocol. If it is, returns a hash | |
193 | reference containing a C<Type> which is either C<encrypted> or | |
194 | C<signed>. The remaining keys are protocol-dependent; the hashref will | |
195 | be provided to L</VerifyDecrypt>. | |
196 | ||
197 | =cut | |
198 | ||
199 | requires 'CheckIfProtected'; | |
200 | ||
201 | =head2 GetKeysInfo Type => ('public'|'private'), Key => EMAIL | |
202 | ||
203 | Returns a list of keys matching the email C<Key>, as described in | |
204 | L<RT::Crypt/GetKeysInfo>. | |
205 | ||
206 | =cut | |
207 | ||
208 | requires 'GetKeysInfo'; | |
209 | ||
210 | =head2 GetKeysForEncryption Recipient => EMAIL | |
211 | ||
212 | Returns a list of keys suitable for encryption, as described in | |
213 | L<RT::Crypt/GetKeysForEncryption>. | |
214 | ||
215 | =cut | |
216 | ||
217 | requires 'GetKeysForEncryption'; | |
218 | ||
219 | =head2 GetKeysForSigning Signer => EMAIL | |
220 | ||
221 | Returns a list of keys suitable for encryption, as described in | |
222 | L<RT::Crypt/GetKeysForSigning>. | |
223 | ||
224 | =cut | |
225 | ||
226 | requires 'GetKeysForSigning'; | |
227 | ||
228 | =head2 ParseDate STRING | |
229 | ||
230 | Takes a string, and parses and returns a L<RT::Date>; if the string is | |
231 | purely numeric, assumes is a epoch timestamp. | |
232 | ||
233 | =cut | |
234 | ||
235 | sub ParseDate { | |
236 | my $self = shift; | |
237 | my $value = shift; | |
238 | ||
239 | # never | |
240 | return $value unless $value; | |
241 | ||
242 | require RT::Date; | |
243 | my $obj = RT::Date->new( RT->SystemUser ); | |
244 | # unix time | |
245 | if ( $value =~ /^\d+$/ ) { | |
246 | $obj->Set( Value => $value ); | |
247 | } else { | |
248 | $obj->Set( Format => 'unknown', Value => $value, Timezone => 'utc' ); | |
249 | } | |
250 | return $obj; | |
251 | } | |
252 | ||
253 | ||
254 | 1; |