1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2017 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
30 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
47 # END BPS TAGGED BLOCK }}}
55 our @EXPORT = qw/safe_run_child mime_recommended_filename/;
57 use Encode qw/encode/;
59 sub safe_run_child (&) {
62 # situation here is wierd, running external app
63 # involves fork+exec. At some point after fork,
64 # but before exec (or during) code can die in a
65 # child. Local is no help here as die throws
66 # error out of scope and locals are reset to old
67 # values. Instead we set values, eval code, check pid
68 # on failure and reset values only in our original
70 my ($oldv_dbh, $oldv_rth);
71 my $dbh = $RT::Handle ? $RT::Handle->dbh : undef;
72 $oldv_dbh = $dbh->{'InactiveDestroy'} if $dbh;
73 $dbh->{'InactiveDestroy'} = 1 if $dbh;
74 $oldv_rth = $RT::Handle->{'DisconnectHandleOnDestroy'} if $RT::Handle;
75 $RT::Handle->{'DisconnectHandleOnDestroy'} = 0 if $RT::Handle;
77 my ($reader, $writer);
78 pipe( $reader, $writer );
84 local @ENV{ 'LANG', 'LC_ALL' } = ( 'C', 'C' );
85 unless ( defined $want ) {
90 @res = ( scalar $code->() );
92 exit 0 if $our_pid != $$;
96 $err =~ s/^Stack:.*$//ms;
97 if ( $our_pid == $$ ) {
98 $dbh->{'InactiveDestroy'} = $oldv_dbh if $dbh;
99 $RT::Handle->{'DisconnectHandleOnDestroy'} = $oldv_rth if $RT::Handle;
100 die "System Error: $err";
102 print $writer "System Error: $err";
108 $reader->blocking(0);
109 my ($response) = $reader->getline;
110 warn $response if $response;
112 $dbh->{'InactiveDestroy'} = $oldv_dbh if $dbh;
113 $RT::Handle->{'DisconnectHandleOnDestroy'} = $oldv_rth if $RT::Handle;
114 return $want? (@res) : $res[0];
117 =head2 mime_recommended_filename( MIME::Head|MIME::Entity )
119 # mimic our own recommended_filename
120 # since MIME-tools 5.501, head->recommended_filename requires the head are
121 # mime encoded, we don't meet this yet.
125 sub mime_recommended_filename {
127 $head = $head->head if $head->isa('MIME::Entity');
129 for my $attr_name (qw( content-disposition.filename content-type.name )) {
130 my $value = Encode::decode("UTF-8",$head->mime_attr($attr_name));
131 if ( defined $value && $value =~ /\S/ ) {
140 return unless utf8::is_utf8($string);
141 return unless $string =~ /([^\x00-\x7F])/;
145 $msg = "Expecting a byte string, but was passed characters";
147 $msg = "Expecting a byte string, but was possibly passed charcters;"
148 ." if the string is actually bytes, please use utf8::downgrade";
150 $RT::Logger->warn($msg, Carp::longmess());
155 =head2 C<constant_time_eq($a, $b)>
157 Compares two strings for equality in constant-time. Replacement for the C<eq>
158 operator designed to avoid timing side-channel vulnerabilities. Returns zero
161 This is intended for use in cryptographic subsystems for comparing well-formed
162 data such as hashes - not for direct use with user input or as a general
163 replacement for the C<eq> operator.
165 The two string arguments B<MUST> be of equal length. If the lengths differ,
166 this function will call C<die()>, as proceeding with execution would create
167 a timing vulnerability. Length is defined by characters, not bytes.
169 Strings that should be treated as binary octets rather than Unicode text
170 should pass a true value for the binary flag.
172 This code has been tested to do what it claims. Do not change it without
173 thorough statistical timing analysis to validate the changes.
175 Added to resolve CVE-2017-5361
177 For more on timing attacks, see this Wikipedia article:
178 B<https://en.wikipedia.org/wiki/Timing_attack>
182 sub constant_time_eq {
183 my ($a, $b, $binary) = @_;
187 # generic error message avoids potential information leaks
188 my $generic_error = "Cannot compare values";
189 die $generic_error unless defined $a and defined $b;
190 die $generic_error unless length $a == length $b;
191 die $generic_error if ref($a) or ref($b);
193 for (my $i = 0; $i < length($a); $i++) {
194 my $a_char = substr($a, $i, 1);
195 my $b_char = substr($b, $i, 1);
197 my (@a_octets, @b_octets);
200 @a_octets = ord($a_char);
201 @b_octets = ord($b_char);
204 # encode() is set to die on malformed
205 @a_octets = unpack("C*", encode('UTF-8', $a_char, Encode::FB_CROAK));
206 @b_octets = unpack("C*", encode('UTF-8', $b_char, Encode::FB_CROAK));
209 die $generic_error if (scalar @a_octets) != (scalar @b_octets);
211 for (my $j = 0; $j < scalar @a_octets; $j++) {
212 $result |= $a_octets[$j] ^ $b_octets[$j];
215 return 0 + not $result;
219 RT::Base->_ImportOverlays();