Commit 5dc75560 authored by mkanat%bugzilla.org's avatar mkanat%bugzilla.org

Bug 513593: Make the WebService taint incoming parameters

Patch by Max Kanat-Alexander <mkanat@bugzilla.org> r=dkl, a=mkanat
parent 877c8ef6
...@@ -233,6 +233,12 @@ sub OPTIONAL_MODULES { ...@@ -233,6 +233,12 @@ sub OPTIONAL_MODULES {
feature => ['jsonrpc'], 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. # We need the 'utf8_mode' method of HTML::Parser, for HTML::Scrubber.
package => 'HTML-Parser', package => 'HTML-Parser',
module => 'HTML::Parser', module => 'HTML::Parser',
......
...@@ -26,6 +26,7 @@ use base qw(JSON::RPC::Server::CGI Bugzilla::WebService::Server); ...@@ -26,6 +26,7 @@ use base qw(JSON::RPC::Server::CGI Bugzilla::WebService::Server);
use Bugzilla::Error; use Bugzilla::Error;
use Bugzilla::WebService::Constants; use Bugzilla::WebService::Constants;
use Bugzilla::WebService::Util qw(taint_data);
use Date::Parse; use Date::Parse;
use DateTime; use DateTime;
...@@ -123,6 +124,8 @@ sub _argument_type_check { ...@@ -123,6 +124,8 @@ sub _argument_type_check {
$params = $params->[0]; $params = $params->[0];
} }
taint_data($params);
# Now, convert dateTime fields on input. # Now, convert dateTime fields on input.
$self->_bz_method_name =~ /^(\S+)\.(\S+)$/; $self->_bz_method_name =~ /^(\S+)\.(\S+)$/;
my ($class, $method) = ($1, $2); my ($class, $method) = ($1, $2);
......
...@@ -68,6 +68,18 @@ eval { require XMLRPC::Lite; }; ...@@ -68,6 +68,18 @@ eval { require XMLRPC::Lite; };
our @ISA = qw(XMLRPC::Deserializer); our @ISA = qw(XMLRPC::Deserializer);
use Bugzilla::Error; 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. # Some method arguments need to be converted in some way, when they are input.
sub decode_value { sub decode_value {
...@@ -126,6 +138,23 @@ sub _validation_subs { ...@@ -126,6 +138,23 @@ sub _validation_subs {
1; 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. # This package exists to fix a UTF-8 bug in SOAP::Lite.
# See http://rt.cpan.org/Public/Bug/Display.html?id=32952. # See http://rt.cpan.org/Public/Bug/Display.html?id=32952.
package Bugzilla::XMLRPC::Serializer; package Bugzilla::XMLRPC::Serializer;
......
...@@ -21,10 +21,17 @@ ...@@ -21,10 +21,17 @@
package Bugzilla::WebService::Util; package Bugzilla::WebService::Util;
use strict; use strict;
use base qw(Exporter); 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 ($$) { sub filter ($$) {
my ($params, $hash) = @_; my ($params, $hash) = @_;
...@@ -44,6 +51,32 @@ sub filter ($$) { ...@@ -44,6 +51,32 @@ sub filter ($$) {
return \%newhash; 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 { sub validate {
my ($self, $params, @keys) = @_; my ($self, $params, @keys) = @_;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment