version => 0,
feature => ['jsonrpc'],
},
+ {
+ package => 'Test-Taint',
+ module => 'Test::Taint',
+ version => 0,
+ feature => ['jsonrpc', 'xmlrpc'],
+ },
{
# We need the 'utf8_mode' method of HTML::Parser, for HTML::Scrubber.
package => 'HTML-Parser',
use Bugzilla::Error;
use Bugzilla::WebService::Constants;
+use Bugzilla::WebService::Util qw(taint_data);
use Date::Parse;
use DateTime;
$params = $params->[0];
}
+ taint_data($params);
+
# Now, convert dateTime fields on input.
$self->_bz_method_name =~ /^(\S+)\.(\S+)$/;
my ($class, $method) = ($1, $2);
our @ISA = qw(XMLRPC::Deserializer);
use Bugzilla::Error;
+use Scalar::Util qw(tainted);
+
+sub deserialize {
+ my $self = shift;
+ my ($xml) = @_;
+ my $som = $self->SUPER::deserialize(@_);
+ if (tainted($xml)) {
+ $som->{_bz_do_taint} = 1;
+ }
+ bless $som, 'Bugzilla::XMLRPC::SOM';
+ return $som;
+}
# Some method arguments need to be converted in some way, when they are input.
sub decode_value {
1;
+package Bugzilla::XMLRPC::SOM;
+use strict;
+eval { require XMLRPC::Lite; };
+our @ISA = qw(XMLRPC::SOM);
+use Bugzilla::WebService::Util qw(taint_data);
+
+sub paramsin {
+ my $self = shift;
+ my $params = $self->SUPER::paramsin(@_);
+ if ($self->{_bz_do_taint}) {
+ taint_data($params);
+ }
+ return $params;
+}
+
+1;
+
# This package exists to fix a UTF-8 bug in SOAP::Lite.
# See http://rt.cpan.org/Public/Bug/Display.html?id=32952.
package Bugzilla::XMLRPC::Serializer;
package Bugzilla::WebService::Util;
use strict;
-
use base qw(Exporter);
-our @EXPORT_OK = qw(filter validate);
+# We have to "require", not "use" this, because otherwise it tries to
+# use features of Test::More during import().
+require Test::Taint;
+
+our @EXPORT_OK = qw(
+ filter
+ taint_data
+ validate
+);
sub filter ($$) {
my ($params, $hash) = @_;
return \%newhash;
}
+sub taint_data {
+ my $params = shift;
+ return if !$params;
+ # Though this is a private function, it hasn't changed since 2004 and
+ # should be safe to use, and prevents us from having to write it ourselves
+ # or require another module to do it.
+ Test::Taint::_deeply_traverse(\&_delete_bad_keys, $params);
+ Test::Taint::taint_deeply($params);
+}
+
+sub _delete_bad_keys {
+ foreach my $item (@_) {
+ next if ref $item ne 'HASH';
+ foreach my $key (keys %$item) {
+ # Making something a hash key always untaints it, in Perl.
+ # However, we need to validate our argument names in some way.
+ # We know that all hash keys passed in to the WebService will
+ # match \w+, so we delete any key that doesn't match that.
+ if ($key !~ /^\w+$/) {
+ delete $item->{$key};
+ }
+ }
+ }
+ return @_;
+}
+
sub validate {
my ($self, $params, @keys) = @_;